home *** CD-ROM | disk | FTP | other *** search
/ Aminet 38 / Aminet 38 (2000)(Schatztruhe)[!][Aug 2000].iso / PPaint / AnimBrushes / AnimFonts / AnimText.pprx next >
Text File  |  1997-05-06  |  12KB  |  504 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1995-1997 Cloanto Italia srl */
  2.  
  3. /* $VER: AnimText.pprx 1.2 */
  4.  
  5. /** ENG
  6.   This script renders a text string using AnimFonts by Kara Computer
  7.   Graphics. The resulting animation is played or placed in the current
  8.   brush.
  9.  
  10.   One AnimFont is included with the Cloanto Personal Suite CD-ROM,
  11.   while The Kara Collection CD-ROM contains five AnimFonts.
  12. */
  13.  
  14. /** DEU
  15.   Dieses Skript erzeugt unter Verwendung der AnimFonts von Kara
  16.   Computer Graphics (nicht in Personal Paint enthalten) eine Zeichenfolge.
  17.   Die daraus resultierende Animation wird wahlweise abgespielt oder im
  18.   aktuellen Brush abgelegt.
  19.  
  20.   Die CD-ROM "The Kara Collection" enthält fünf AnimFonts. Die CD-ROM
  21.   "Personal Suite" enthält ein AnimFont. 
  22. */
  23.  
  24. /** ITA
  25.   Questo script realizza una stringa di testo utilizzando AnimFonts di Kara
  26.   Computer Graphics. L'animazione risultante viene mostrata oppure è inserita
  27.   nel pennello corrente.
  28.  
  29.   I font animati "AnimFonts" sono compresi nel CD-ROM Cloanto The Kara
  30.   Collection. Il CD-ROM Personal Suite contiene un font animato.
  31. */
  32.  
  33. absh_dir.1 = 'PPaint:AnimBrushes/AnimFonts'
  34. data_dir.1 = 'PPaint:AnimBrushes/AnimFonts'
  35. absh_dir.2 = 'KaraCD:PPaint/AnimBrushes/AnimFonts'
  36. data_dir.2 = 'KaraCD:PPaint/AnimBrushes/AnimFonts'
  37. absh_dir.3 = 'PSuite:PPaint/AnimBrushes/AnimFonts'
  38. data_dir.3 = 'PSuite:PPaint/AnimBrushes/AnimFonts'
  39. path_num   = 3
  40.  
  41. IF ARG(1, EXISTS) THEN
  42.     PARSE ARG PPPORT
  43. ELSE
  44.     PPPORT = 'PPAINT'
  45.  
  46. IF ~SHOW('P', PPPORT) THEN DO
  47.     IF EXISTS('PPaint:PPaint') THEN DO
  48.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  49.         DO 30 WHILE ~SHOW('P',PPPORT)
  50.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  51.         END
  52.     END
  53.     ELSE DO
  54.         SAY "Personal Paint could not be loaded."
  55.         EXIT 10
  56.     END
  57. END
  58.  
  59. IF ~SHOW('P', PPPORT) THEN DO
  60.     SAY 'Personal Paint Rexx port could not be opened'
  61.     EXIT 10
  62. END
  63.  
  64. ADDRESS VALUE PPPORT
  65. OPTIONS RESULTS
  66. OPTIONS FAILAT 10000
  67.  
  68. Get 'LANG'
  69. IF RESULT = 1 THEN DO        /* Deutsch */
  70.     txt_title_req     = 'AnimText-Einstellungen'
  71.     txt_gad_lst       = 'Anim_Font:'
  72.     txt_gad_str       = '_Text:'
  73.     txt_string_str    = 'Text'
  74.     txt_gad_cyc       = '_Darstellen:'
  75.     txt_gad_cyc0      = 'Von Links nach Rechts'
  76.     txt_gad_cyc1      = 'Gleichzeitig'
  77.     txt_gad_num0      = 'Ab_stand:'
  78.     txt_gad_num1      = 'Einzelbild-_Offset:'
  79.     txt_gad_chk       = 'Anim-_Brush:'
  80.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  81.     txt_err_noafonts  = 'AnimFonts konnten nicht_gefunden werden'
  82.     txt_err_nodfile   = 'Fontdatei konnte nicht_gefunden werden'
  83.     txt_err_noenv     = 'Andere Umgebung_kann nicht erstellt werden'
  84. END
  85. ELSE IF RESULT = 3 THEN DO    /* Français */
  86.     txt_title_req     = "Réglages d'AnimText"
  87.     txt_gad_lst       = 'Anim_Font :'
  88.     txt_gad_str       = '_Texte :'
  89.     txt_string_str    = 'Texte'
  90.     txt_gad_cyc       = 'Apparitio_n :'
  91.     txt_gad_cyc0      = 'De gauche à droite'
  92.     txt_gad_cyc1      = 'Simultanément'
  93.     txt_gad_num0      = 'E_spacement :'
  94.     txt_gad_num1      = '_Retard :'
  95.     txt_gad_chk       = '_Brosse animée :'
  96.     txt_err_oldclient = 'Ce script nécessite une nouvelle_version de Personal Paint'
  97.     txt_err_noafonts  = 'AnimFonts non trouvées'
  98.     txt_err_nodfile   = 'Impossible de trouver_le fichier de données_de la police'
  99.     txt_err_noenv     = "Impossible de créer_l'autre environnement"
  100. END
  101. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  102.     txt_title_req     = 'Parametri AnimText'
  103.     txt_gad_lst       = 'Anim_Font:'
  104.     txt_gad_str       = '_Testo:'
  105.     txt_string_str    = 'Testo'
  106.     txt_gad_cyc       = '_Scrittura:'
  107.     txt_gad_cyc0      = 'Da sinistra a destra'
  108.     txt_gad_cyc1      = 'Simultanea'
  109.     txt_gad_num0      = '_Spaziatura:'
  110.     txt_gad_num1      = 'Sp_ostamento:'
  111.     txt_gad_chk       = 'Anim-_Brush:'
  112.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  113.     txt_err_noafonts  = 'Impossibile trovare AnimFont'
  114.     txt_err_nodfile   = 'Impossibile aprire_il file dati'
  115.     txt_err_noenv     = 'Impossibile creare_ambiente alternativo'
  116. END
  117. ELSE DO                /* English */
  118.     txt_title_req     = 'AnimText Settings'
  119.     txt_gad_lst       = 'Anim_Font:'
  120.     txt_gad_str       = '_Text:'
  121.     txt_string_str    = 'Text'
  122.     txt_gad_cyc       = '_Render:'
  123.     txt_gad_cyc0      = 'Left to right'
  124.     txt_gad_cyc1      = 'Simultaneously'
  125.     txt_gad_num0      = '_Spacing:'
  126.     txt_gad_num1      = 'F_rame Offset:'
  127.     txt_gad_chk       = 'Anim-_Brush:'
  128.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  129.     txt_err_noafonts  = 'AnimFonts not found'
  130.     txt_err_nodfile   = 'Font data file_cannot be found'
  131.     txt_err_noenv     = 'Other environment_cannot be created'
  132. END
  133.  
  134. Version 'REXX'
  135. IF RESULT < 7 THEN DO
  136.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  137.     EXIT 10
  138. END
  139.  
  140. FreeBrush
  141. IF RC ~= 0 THEN
  142.     EXIT RC
  143.  
  144. /* Build the list of available AnimFonts */
  145.  
  146. tmpfname = 'T:pprx_temp.'PRAGMA('ID')
  147. ftot = 0
  148. CALL PRAGMA('Window', 'Null')
  149.  
  150. DO pnum = 1 to path_num
  151.     sv_cd = PRAGMA('D')
  152.     IF PRAGMA('D', absh_dir.pnum) = sv_cd THEN DO
  153.         CALL PRAGMA('D', sv_cd)
  154.         ADDRESS COMMAND 'List >'tmpfname' 'absh_dir.pnum' NOHEAD LFORMAT="%s" DIRS'
  155.         IF RC = 0 THEN DO
  156.             ADDRESS COMMAND 'Sort 'tmpfname tmpfname'.s'
  157.             IF RC = 0 THEN DO
  158.                 ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  159.                 tmpfname = tmpfname'.s'
  160.             END
  161.             IF OPEN('listfile', tmpfname, 'R') THEN DO
  162.                 DO FOREVER
  163.                     fline = READLN('listfile')
  164.                     IF EOF('listfile') THEN BREAK
  165.                     ftot = ftot + 1
  166.                     fontname.ftot = fline
  167.                 END
  168.                 CALL CLOSE('listfile')
  169.             END
  170.         END
  171.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  172.         IF ftot ~= 0 THEN
  173.             LEAVE
  174.     END
  175. END
  176. CALL PRAGMA('Window', 'Workbench')
  177.  
  178. IF ftot = 0 THEN DO
  179.     RequestNotify 'PROMPT "'txt_err_noafonts'"'
  180.     EXIT 10
  181. END
  182.  
  183.  
  184. /* Build and show the settings requester */
  185.  
  186. font = LoadSet('Font', 0)
  187. txt_string_str = LoadSet('Text', txt_string_str)
  188. render  = LoadSet('Render', 0)
  189. spacing = LoadSet('Spacing', 0)
  190. offset  = LoadSet('Offset', 0)
  191. getbsh  = LoadSet('Getbsh', 1)
  192.  
  193. req = '"LIST = ""'txt_gad_lst'"", 'ftot', 'font', 20, 5'  /* max 5 rows to fit into a 320x200 screen */
  194. DO f = 1 TO ftot
  195.     req = req || ', ""' || fontname.f || '""'
  196. END
  197.  
  198. req = req ||,
  199.     ' STRING = ""'txt_gad_str'"", 256, ""'txt_string_str'"" ' ||,
  200.     'CYCLE = ""'txt_gad_cyc'"", 2, 'render', ""'txt_gad_cyc0'"", ""'txt_gad_cyc1'"" ' ||,
  201.     'INTSTR = ""'txt_gad_num0'"", -32768, 32767, 'spacing' ' ||,
  202.     'INTSTR = ""'txt_gad_num1'"", -32768, 32767, 'offset' ' ||,
  203.     'CHECK = ""'txt_gad_chk'"", 'getbsh' "'
  204.  
  205. Request 'RESIZE "'txt_title_req'"' req
  206. IF RC = 0 THEN DO
  207.     font    = RESULT.1
  208.     text    = RESULT.2
  209.     render  = RESULT.3
  210.     spacing = RESULT.4
  211.     offset  = RESULT.5
  212.     getbsh  = RESULT.6
  213.  
  214.     CALL SaveSet('Font', font)        /* setting persistence */
  215.     CALL SaveSet('Text', text)
  216.     CALL SaveSet('Render', render)
  217.     CALL SaveSet('Spacing', spacing)
  218.     CALL SaveSet('Offset', offset)
  219.     CALL SaveSet('Getbsh', getbsh)
  220. END
  221. ELSE EXIT 0
  222.  
  223. font = font + 1
  224. abshpath = absh_dir.pnum'/'fontname.font'/'
  225. dataname = data_dir.pnum'/'fontname.font'.data'
  226.  
  227. len = LENGTH(text)
  228. fontdata. = 'undef'
  229.  
  230.  
  231.  
  232. /* Read data file */
  233.  
  234. IF OPEN('datafile', dataname, 'R') THEN DO
  235.     READLN('datafile')
  236.     skip_first = READLN('datafile')
  237.     frm_offset = READLN('datafile')
  238.     DO FOREVER
  239.         fline = READLN('datafile')
  240.         IF EOF('datafile') THEN BREAK
  241.         PARSE VAR fline chr nm spc hdx
  242.         fontdata.name.chr  = nm
  243.         fontdata.space.chr = spc
  244.         fontdata.handx.chr = hdx
  245.     END
  246.     CALL CLOSE('datafile')
  247. END
  248. ELSE DO
  249.     RequestNotify 'PROMPT "'txt_err_nodfile'"'
  250.     EXIT 10
  251. END
  252.  
  253.  
  254.  
  255. /* Render the text */
  256.  
  257. LockGUI
  258.  
  259. Get 'IMAGEW'
  260. img_width = RESULT
  261. Get 'DISPLAY'
  262. img_disp = RESULT
  263.  
  264. SwitchEnvironment
  265. FreeEnvironment 'QUERY'
  266. IF RC ~= 0 THEN DO
  267.     UnlockGUI
  268.     EXIT RC
  269. END
  270.  
  271. Get 'GCLIP'
  272. saveclip = RESULT
  273. Set '"GCLIP=0"'
  274.  
  275. DeleteFrames 'ALL FORCE'
  276. ClearImage
  277. SetPaintMode 'MATTE'
  278. xmax = 0
  279. ymax = 0
  280. error = 0
  281. IF render = 0 THEN DO    /* Left to right */
  282.     xpos = 0
  283.     ypos = 0
  284.     first = 1
  285.     DO c = 1 TO len
  286.         chr = UseChar(SUBSTR(text, c, 1))
  287.         IF chr = 32 | chr = 60 | chr = 62 THEN DO
  288.             IF fontdata.space.chr ~= 'undef' THEN
  289.                 xpos = xpos + fontdata.space.chr + spacing
  290.         END
  291.         ELSE DO
  292.             LoadAnimBrush '"'abshpath || fontdata.name.chr'"' FORCE QUIET NOPROGRESS
  293.             IF RC = 0 THEN DO
  294.                 GetBrushAttributes 'FRAMES'
  295.                 frm = RESULT
  296.                 IF skip_first THEN
  297.                     frm = frm - 1
  298.  
  299.                 IF first THEN DO
  300.                     first = 0
  301.                     error = SetupEnv(img_width, img_disp)
  302.                     IF error ~= 0 THEN
  303.                         LEAVE c
  304.                     UseBrushPalette
  305.                     IF fontdata.handx.chr > 0 THEN
  306.                         xpos = fontdata.handx.chr
  307.  
  308.                     AddFrames frm
  309.                 END
  310.                 ELSE DO
  311.                     GetFrames
  312.                     tot = RESULT
  313.                     pos = tot + frm_offset + offset
  314.                     add = frm - (tot - pos)
  315.                     IF add > 0 THEN
  316.                         AddFrames add 'AFTER' tot
  317.                     SetFramePosition pos + 1
  318.                 END
  319.  
  320.                 SetBrushAttributes 'FRAMEPOSITION 2 HANDLEX' fontdata.handx.chr 'HANDLEY 0'
  321.                 DO f = 1 TO frm
  322.                     PutBrush xpos ypos
  323.                     SetFramePosition 'NEXT'
  324.                 END
  325.  
  326.                 GetBrushAttributes 'WIDTH'
  327.                 x1 = xpos - fontdata.handx.chr + RESULT - 1
  328.                 IF x1 > xmax THEN
  329.                     xmax = x1
  330.                 GetBrushAttributes 'HEIGHT'
  331.                 y1 = ypos + RESULT - 1
  332.                 IF y1 > ymax THEN
  333.                     ymax = y1
  334.                 xpos = xpos + fontdata.space.chr + spacing
  335.             END
  336.         END
  337.     END
  338. END
  339. ELSE DO    /* Simultaneously */
  340.     max_frm = 0
  341.     DO c = 1 TO len
  342.         chr = UseChar(SUBSTR(text, c, 1))
  343.         IF chr ~= 32 & chr ~= 60 & chr ~= 62 THEN DO
  344.             LoadAnimBrush '"'abshpath || fontdata.name.chr'" FORCE QUIET NOPROGRESS'
  345.             IF RC = 0 THEN DO
  346.                 GetBrushAttributes 'FRAMES'
  347.                 frm = RESULT
  348.                 IF frm > max_frm THEN
  349.                     max_frm = frm
  350.             END
  351.         END
  352.     END
  353.     error = SetupEnv(img_width, img_disp)
  354.     IF error = 0 THEN DO
  355.         IF skip_first THEN
  356.             max_frm = max_frm - 1
  357.         UseBrushPalette
  358.         AddFrames max_frm
  359.  
  360.         DO f = 1 TO max_frm
  361.             xpos = 0
  362.             ypos = 0
  363.             first = 1
  364.             DO c = 1 TO len
  365.                 chr = UseChar(SUBSTR(text, c, 1))
  366.                 IF chr = 32 | chr = 60 | chr = 62 THEN DO
  367.                     IF fontdata.space.chr ~= 'undef' THEN
  368.                         xpos = xpos + fontdata.space.chr + spacing
  369.                 END
  370.                 ELSE DO
  371.                     LoadAnimBrush '"'abshpath || fontdata.name.chr'" FORCE QUIET NOPROGRESS'
  372.                     IF RC = 0 THEN DO
  373.                         GetBrushAttributes 'FRAMES'
  374.                         frm = RESULT
  375.  
  376.                         IF first THEN DO
  377.                             first = 0
  378.                             IF fontdata.handx.chr > 0 THEN
  379.                                 xpos = fontdata.handx.chr
  380.                         END
  381.                         fpos = f + 1
  382.                         IF fpos > frm THEN DO
  383.                             IF skip_first THEN
  384.                                 fpos = frm
  385.                             ELSE
  386.                                 fpos = 1
  387.                         END
  388.                         SetBrushAttributes 'FRAMEPOSITION' fpos 'HANDLEX' fontdata.handx.chr 'HANDLEY 0'
  389.                         PutBrush xpos ypos
  390.  
  391.                         IF f = 1 THEN DO
  392.                             GetBrushAttributes 'WIDTH'
  393.                             x1 = xpos - fontdata.handx.chr + RESULT - 1
  394.                             IF x1 > xmax THEN
  395.                                 xmax = x1
  396.                             GetBrushAttributes 'HEIGHT'
  397.                             y1 = ypos + RESULT - 1
  398.                             IF y1 > ymax THEN
  399.                                 ymax = y1
  400.                         END
  401.                         xpos = xpos + fontdata.space.chr + spacing
  402.                     END
  403.                 END
  404.             END
  405.             SetFramePosition 'NEXT'
  406.         END
  407.     END
  408. END
  409.  
  410. IF error = 0 THEN DO
  411.     SetFramePosition 1
  412.     IF getbsh THEN DO
  413.         GetFrames
  414.         frm = RESULT
  415.         DefineBrush 0 0 xmax ymax frm
  416.         IF RC = 0 THEN
  417.             FreeEnvironment 'FORCE'
  418.     END
  419.     ELSE DO
  420.         FreeBrush 'FORCE'
  421.         Play 'FORCE'
  422.     END
  423. END
  424. ELSE
  425.     RequestNotify 'PROMPT "'txt_err_noenv'"'
  426.  
  427. Set '"GCLIP='saveclip'"'
  428. UnlockGUI
  429. EXIT 0
  430.  
  431.  
  432.  
  433.  
  434. UseChar:
  435.     ch = ARG(1)
  436.  
  437.     code = C2D(ch)
  438.  
  439.     IF fontdata.space.code = 'undef' THEN DO
  440.         IF ch >= 'A' & ch <= 'Z' THEN
  441.             code = code + 32
  442.         ELSE IF ch >= 'a' & ch <= 'z' THEN
  443.             code = code - 32
  444.  
  445.         IF fontdata.space.code = 'undef' THEN
  446.             code = 32
  447.     END
  448.  
  449.     RETURN code
  450.  
  451.  
  452.  
  453.  
  454. SetupEnv:
  455.     imgw = ARG(1)
  456.     imgd = ARG(2)
  457.  
  458.     GetBrushAttributes 'COLORS'
  459.     cnum = RESULT
  460.     GetBrushAttributes 'HEIGHT'
  461.     imgh = RESULT
  462.  
  463.     Set '"IMAGEW='imgw'" "IMAGEH='imgh'" "COLORS='cnum'" "DISPLAY='imgd'" "SCREENW=-1" "SCREENH='imgh'" "ASCROLL=0"'
  464.  
  465.     RETURN RC
  466.  
  467.  
  468.  
  469.  
  470. SaveSet:
  471.     sname = ARG(1)
  472.     val = ARG(2)
  473.  
  474.     IF OPEN('settingfile', 'ENV:PP_AnimText_'sname, 'W') THEN DO
  475.         CALL WRITECH('settingfile', val)
  476.         CALL CLOSE('settingfile')
  477.     END
  478.  
  479.     RETURN
  480.  
  481.  
  482.  
  483.  
  484. LoadSet:
  485.     sname = ARG(1)
  486.     def_val = ARG(2)
  487.  
  488.     val = def_val
  489.     IF OPEN('settingfile', 'ENV:PP_AnimText_'sname, 'R') THEN DO
  490.         val = READCH('settingfile', 65535)
  491.         CALL CLOSE('settingfile')
  492.     END
  493.  
  494.     /* encode quotes for the Request command ('"' -> '\""') */
  495.     qpos_start = 1
  496.     DO FOREVER
  497.         qpos = INDEX(val, '"', qpos_start)
  498.         IF qpos = 0 THEN BREAK
  499.         val = INSERT('\"', val, qpos-1)
  500.         qpos_start = qpos + 3
  501.     END
  502.  
  503.     RETURN val
  504.